perm filename DRWCIR.SAI[PIC,HE] blob
sn#430333 filedate 1979-04-03 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY DRWCIRC,CIRC,CIRINIT,CIREND,CONCIR
C00005 ENDMK
C⊗;
ENTRY DRWCIRC,CIRC,CIRINIT,CIREND,CONCIR;
BEGIN "DRWCIR"
REQUIRE "36A" COMPILER!SWITCHES;
REQUIRE "GRAPH.DCL" SOURCE!FILE;
EXTERNAL INTEGER TEKWHERE;
OWN INTEGER CIRT;
SIMPLE INTERNAL PROCEDURE DRWCIRC(REAL I,J,R);
BEGIN
REAL X,Y,R2,X1,Y1;
R2←R*R;
MOVEA(X1←I-R,Y1←J);
FOR X←-R STEP 0.10 UNTIL R, R STEP -0.10 UNTIL -R DO
DRAWA(X1←I+X,Y1←J+SQRT(R2-X*X));
END;
PRELOAD!WITH 3.0,-8.0,8.0,-8.0,8.0,0.0,0.0,-7.0,7.0,-4.0,-4.0,3.5,-1.0;
SAFE INTERNAL REAL ARRAY XLC[1:13];
PRELOAD!WITH 2.0,8.0,8.0,-8.0,-8.0,7.0,-7.0,0.0,0.0,5.0,-4.0,-3.5,2.0;
SAFE INTERNAL REAL ARRAY YLC[1:13];
SIMPLE INTERNAL PROCEDURE CIRC(INTEGER N; STRING LABB);
BEGIN
DRWCIRC(XLC[N],YLC[N],1.0);
STRAT(LABB,XLC[N]-1,YLC[N]);
END;
SIMPLE INTERNAL PROCEDURE CIRINIT;
BEGIN
IF CIRT=0 THEN BEGIN
PCTR(TEKWHERE);
INITT(450);
VWINDO(-10.0,20.0,-10.0,20.0);
END;
CIRT←-1;
END;
SIMPLE INTERNAL PROCEDURE CIREND;
BEGIN
ENDPCT;
CIRT←0;
END;
SIMPLE INTERNAL PROCEDURE CONCIR(INTEGER C1,C2; STRING LABB; REAL POSIT);
BEGIN
REAL DX,DY,DZ,SX,SY,EX,EY;
REAL LX,LY;
DX←XLC[C1]-XLC[C2];
DY←YLC[C1]-YLC[C2];
DZ←SQRT(DX*DX+DY*DY);
DX←DX/DZ;
DY←DY/DZ;
SX←XLC[C1]-DX;
SY←YLC[C1]-DY;
EX←XLC[C2]+DX;
EY←YLC[C2]+DY;
MOVEA(SX,SY);
DRAWA(EX,EY);
LX←SX+(EX-SX)*POSIT-0.5;
LY←SY+(EY-SY)*POSIT;
STRAT(LABB,LX,LY);
DX←DX/2.0; DY←DY/2.0;
SX←EX+DX+DY; SY←EY+DY-DX;
MOVEA(SX,SY); DRAWA(EX,EY);
SX←EX+DX-DY; SY←EY+DY+DX;
MOVEA(SX,SY); DRAWA(EX,EY);
END;
END "DRWCIR";